perm filename NTS.FAI[XX,LCS]2 blob
sn#210717 filedate 1976-04-12 generic text, type T, neo UTF8
00100 TITLE NTS
00200 ENTRY NTS,STAFF
00300 EXTERNAL .COMM.,ALF,POSI,AMOD,CENTX,RDRAW,PLTR,STF,EXTRA
00400 EXTERNAL LINX,DRWNT,DAT,NOIR,TAIL,LINES,RHORZ
00500 ;SUBROUTINE NOTWRT
00600 ;IMPLICIT INTEGER(A-Q,S-Z)
00700 ;COMMON/DL/IXRX,M,AA /FONT/JFONT
00800 ;COMMON/SCM/V(78),ISCR,LCNT,RSTF,LIST(200),REND
00900 ;COMMON/DAT/RACNT(65),RDOT(17),XAC(7),RNOTE(22),RACCI(22),NACCI(3)
01000 ;REAL DIS,CENTR,POS,STFF
01100 ;COMMON /STF/RSTFAC(-3/4),RSTJ2
01200 ;COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)
01300 ;COMMON/PLTR/PLT,RHT,DIS /POSI/STFF(-3/4),JJ2,POS
01400 ; ITEMS IN FOLLOWING COMMON BLOCK ARE USED IN 'TAILS' AND 'FERM'
01500 ;COMMON/ALF/INP(46),RST7,RST3,RSTX,RMINI,RINV,RA,RX,RJX,RJY,
01600 ;1 RB,RJW,RZ,JX,RG,KL,RJAC,K,L,RQ,RH,RZTM,RXX,JJJ,
01700 ;1 PUNCT,JY,RJ
01800 ;EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R4,RJQ(2))
01900 ;1,(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8)),
02000 ; 1(J11,JQ(9)),(J6,JQ(4)),(R5,RJQ(3)),(R11,RJQ(9)),(STEM,JQ(20))
02100 ; 1,(R8,RJQ(6)),(R7,RJQ(5)),(RX,JRX),(RJZ,RJQ(20)),(R3,RJQ(1))
02200 ; 1,(RX4,JQ(19)),(STEM,JQ(20))
02300
02400 DEFINE FIXX(N)
02500 < JUMPGE N,.+5
02600 MOVNS N
02700 FIX N,233000
02800 MOVNS N
02900 CAIA
03000 FIX N,233000 >
03100
03200 NTS: 0 ; NOTES****
03250 MOVE .COMM.+=26 ;STEM=J5/10
03275 IDIVI =10
03287 MOVEM .COMM.+=43 ; STEM
03300 MOVM 7,.COMM.+=27 ; (J6) 11 JY=0
03400 SKIPN .COMM.+7 ;IF(R6.EQ.0)GO TO 1015
03500 JRST N1 ;JY=IABS(J6)
03600 ;;; MOVMS 15 ;R6=ABS(AMOD(R6,1.0))*10.
03700 JSA 16,AMOD
03800 JUMP .COMM.+7
03900 JUMP [1.0]
04000 FMPR [10.0]
04100 MOVMM .COMM.+7 ; R6
04200 N1: MOVM 14,.COMM.+=25 ;R6 WILL HAVE ACCENT CODE # (.7=DOT, ETC.)
04300 ; L 1015 L=IABS(J4)
04350 MOVEM 7,ALF+=70 ;PUT AWAY JY IN RIGHT PLACE FOR NOTSUB.
04400 MOVE .COMM.+4 ;RJAC=R3
04500 MOVEM ALF+=61
04600 MOVE 13,[2.0] ; TO SAVE POS. OF NOTE FOR ACCENT
04700 FMPR 13,STF+10 ; 13 IS RZTM=2.*RSTJ2
04800 N1010: CAIGE 14,=100 ;1010 IF(L.LT.100)GO TO 1013
04900 JRST N1013
05000 CAIGE 14,=200 ;IF(L.LT.200)GO TO 1012
05100 JRST N1012
05200 SETZ 13, ;RZTM=0
05300 CAIL 14,=300 ;IF(L.GE.300)GO TO 1014
05400 JRST N1014
05500 MOVEI 12,10 ; 12 IS KL=8
05600 MOVE 11,[12.0] ; 11 IS RG=12.0
05700 JRST N1013 ; FOR DIAMOND NOTES.
05800 N1014: CAIL 14,=400 ;GO TO 1013
05900 JRST N1016 ;1014 IF(L.GE.400)GO TO 1016
06000 MOVE 10,[7.0] ; 10 IS RJX=RMINI*7
06100 FMPR 10,ALF+=49 ; *RMINI (+49)
06200 MOVEI 12,=13 ; FOR "X" NOTES.
06300 MOVE 11,[16.0] ;KL=13
06400 MOVE 2,.COMM.+=43 ; STEM RG=16.
06500 CAIN 2,2 ;RB=CENTR+RJX
06600 MOVNS 10 ;IF(STEM.EQ.2)RB=CENTR-RJX
06700 FADR 10,.COMM.+2 ; 10 IS RB
06900 JRST N1013 ;GO TO 1013
07000 N1016: CAIGE 14,=1000 ;1016 IF(L.LT.1000.OR.L.GE.10000)GO TO 1011
07100 JRST N1019
07200 CAML 14,[=10000]
07300 JRST N1013
07400 SETO 12, ;KL=-1
07500 CAIGE 14,=2000 ;IF(L.LT.2000)KL=-KL
07600 MOVNS 12
07700 ;PUTS NOTE ON STF ABOVE(2000) OR BELOW(1000)-NEXT FIND POS ON OTHER STF
07800 MOVE 2,.COMM.+3 ;RB=(STFF(J2-KL)-STFF(J2))/RST7
07900 ADDI 2,3 ; STF#+3(+1)
08000 MOVN 3,POSI(2)
08100 SUB 2,12
08200 FADR 3,POSI(2)
08300 FDVR 3,ALF+=46 ; RB
08500 FADRM 3,.COMM.+5 ;R4=R4+RB
08600 JSA 16,CENTX ;CALL CENTX
08700 ; STEM WILL GO TO EQUIV. SPOT ON "HOME" STAFF. USE NEG P8 TO ADJUST
08800 MOVE 2,.COMM.+=9 ;IF(R8.EQ.999)R8=0
08900 CAMN 2,[999.0]
09000 SETZM .COMM.+=9
09100 SKIPLE 3 ;RZ=ABS(RB)
09200 MOVNS 3 ; RZ IS NOW NEG!!!
09300 MOVE 2,.COMM.+=26 ; J5 IF(KL.AND.J5.GE.20)RZ=-RZ
09400 JUMPGE 12,NX1
09500 CAIL 2,=20
09600 JRST .+3
09700 NX1: JUMPE 12,.+3
09800 CAIGE 2,=20 ;IF(KL.GT.0.AND.J5.LT.20)RZ=-RZ
09900 MOVNS 3 ;R8=R8-RZ
10000 FADRM 3,.COMM.+=9
10100 ;C???????? THIS WAS DONE ALREADY CALL CENTX
10200 ; RESET BASIC VERT. POS. (BASED ON P4. AMOD IS DONE IN CENTX)
10300 IDIVI 14,=1000 ;JSA 16,MOD ;L=MOD(L,1000)
10400 MOVE 14,15 ;JUMP 14
10500 ;JUMP [=1000] , MOVE 14,
10600 SETOM .COMM.+=30 ;J9=-1
10700 ; SUPRESSES LEDGER LINES -- CAN'T USE LEDGER LINES ON OTHER STAFF!
10800 JRST N1010 ;GO TO 1010
10900 N1019: CAIL 14,=480 ;1011 IF(L.LT.10000)GO TO 1019
11000 JRST N1017 ;GO TO 1013
11100 MOVE 10,.COMM.+=12 ; R11 1019 IF(L.GE.480)GO TO 1017
11200 FMPR 10,ALF+=46
11300 FADR 10,.COMM.+2 ;RB=CENTR+R11*RST7
11400 JRST N1013 ;+400 = NO NOTE HEAD. P11 CAN ADJUST SOURCE OF STEM.
11500 N1017: JSA 16,EXTRA ;GO TO 1013
11600 SETOM .COMM.+=43 ;1017 RG=R4
11700 JRA 16,(16) ;CALL EXTRA
11800 ; 'EXTRA' IS FOR USER-ADDED NOTE AND REST SHAPES. P4+ 500(OR 600 TOO?)
11900 ; 480 IS USED SO NOTES CAN BE AT 500-19
12000 ;RETURN
12100 N1012: MOVE 2,STF+10 ;1012 RMINI=.6*RSTJ2
12200 FMPR 2,[0.6]
12300 MOVEM 2,ALF+=49 ; RMINI
12400 ; FOR RMINI NOTES
12500 ;;** DONE IN CENTX *** 1017 ;R4=AMOD(R4,100.)
12600 ; FOR MINI TAILS AND ACCIS. ETC.
12700 N1013: MOVE 2,.COMM.+5 ;1013 J4=R4
12800 MOVEM 2,.COMM.+=42 ; JQ(19) IS EQUIV. TO RX4
12810 MOVEM 2,.COMM.+=23 ; RJZ
12900 FIXX(2)
13000 MOVEM 2,.COMM.+=25 ; J4 RJZ=R4
13100 ; RJZ FOR FLAT, #, NAT. RX4 FOR TR., HARM, ETC.
13110 MOVEM 10,ALF+=55 ; RB
13200 MOVEM 11,ALF+=69 ; RG IF(JY.LT.10)GO TO 2221
13300 MOVEM 12,ALF+=60 ; KL
13400 MOVEM 13,ALF+=66 ; RZTM
13450 MOVEM 14,ALF+=63 ; PUT AWAY L FOR NOTWRT
13500 CAIL 7,=10
13600 CAIL 7,=30
13700 JRST N2221
13800 MOVE 4,[14.54] ;IF(JY.GE.30)GO TO 2221
13900 ; P6 FOR HOMING TO RIGHT(10,30) OR LEFT(20) OF STEM(10,30=UP, 20=DOWN)
14000 ; P6<0 = WHITE NOTE
14100 SKIPGE .COMM.+=27 ; J6 RQ=RSTM
14200 FADR 4,[1.66] ;IF(J6)RQ=RQ+1.66
14300 ; GETS WIDTH OF NOTE DISPLACEMENT
14400 CAIN 7,=20 ;IF(JY.EQ.20)RQ=-RQ
14500 MOVNS 4
14600 FMPR 4,ALF+=49 ;R3=R3+RQ*RMINI
14700 FADRM 4,.COMM.+4 ; R3
14800 N2221: CAIG 2,1 ;2221 IF(J4.LE.1)GO TO 322
14900 JRST N322
15000 CAIL 2,=13 ;IF(J4.LT.13)GO TO 1121
15100 N322: SKIPGE .COMM.+=30 ;322 IF(J9)GO TO 1121
15200 JRST N1121
15300 ; ARE THERE LEDGER LINES? P9=-1 SUPPRESSES THEM.
15400 MOVE 3,2 ;J11=(J4+1)/2-6
15500 AOJ 3,
15600 IDIVI 3,2 ; (AC4 NOT USED YET)
15700 SUBI 3,6 ; 3 IS J11
15800 MOVEM 3,.COMM.+=32
15900 JUMPGE 3,.+5 ;IF(J11)J11=-((3-J4)/2)
16000 MOVE 3,2
16100 SUBI 3,3
16200 IDIVI 3,2
16400 MOVEM 3,.COMM.+=32 ; J11
16500 ; FOR LEDGER LINES
16600 MOVN 4,ALF+=49 ;RJW=R3-7.*RMINI
16700 FMPR 4,[7.0]
16800 FADR 4,.COMM.+4
16900 MOVEM 4,ALF+=56 ; RJW
17000 MOVE 5,ALF+=49 ;RZ=R3+20.*RMINI
17100 FMPR 5,[20.0]
17200 FADR 5,.COMM.+4 ; RZ
17300 MOVEM 5,ALF+=57 ; RZ
17400 JUMPL 3,N71 ;IF(J11)GO TO 71
17500 MOVEI 6,=13 ;JX=J11
17600 MOVEM 3,ALF+=58 ; JX JRX=13
17700 JRST N711 ;GO TO 711
17800 N71: MOVEI 6,2 ;71 JX=-J11
17900 IMUL 6,3 ;JRX=J11*2+3
18000 ADDI 6,3
18100 MOVNM 3,ALF+=58 ; JX
18200 N711: MOVN 7,[18.0] ;711 RX=POS-18*RSTJ2+RST7*JRX
18300 FMPR 7,STF+10
18400 TLC 6,232000 ; FLOAT IT
18500 FADR 6,6
18600 FMPR 6,ALF+=46
18700 FADR 6,7
18800 FADR 6,POSI+=9 ;IF(J6)RZ=RZ+2*RMINI
18900 MOVEM 6,ALF+=52 ; RX IS 6
19000 SKIPL .COMM.+=27
19100 JRST N126
19200 MOVE 2,ALF+=49 ; RMINI
19300 FMPR 2,[2.0]
19400 FADRM 2,ALF+=57 ; RZ
19500 N126: JSA 16,LINX ;126 CALL LINX(RJW,RX,RZ,RX)
19600 JUMP ALF+=56
19700 JUMP ALF+=52
19800 JUMP ALF+=57
19900 JUMP ALF+=52
20000 MOVN 2,PLTR ;IF(PLT.NE.-2)GO TO 1126
20100 CAIE 2,2
20200 JRST N1126
20300 MOVN 2,[1.0] ;RJY=RX-1./RHT
20400 FDVR 2,PLTR+1
20500 FADR 2,ALF+=52 ; RX
20600 MOVEM 2,ALF+=54 ; RJY
20700 JSA 16,LINX ;CALL LINX(RJW,RJY,RZ,RJY)
20800 JUMP ALF+=56
20900 JUMP ALF+=54
21000 JUMP ALF+=57
21100 JUMP ALF+=54
21200 N1126: MOVE 3,ALF+=58 ; JX 1126 IF(JX.EQ.1)GO TO 1122
21300 CAIN 3,1
21400 JRST N1122
21500 MOVE 2,STF+10 ;RX=RX+RSTJ2*14.
21600 FMPR 2,[14.0]
21700 FADRM 2,ALF+=52 ; RX
21800 SOS ALF+=58 ;JX=JX-1
21900 JRST N126 ;GO TO 126
22000 N1122: SETOM .COMM.+=30 ;1122 J9=-1
22100 ; IF J6≠0 NOTE IS FILLED IN
22200 ; 1121 IF(L.GE.400)GO TO 123
22300 ; JUMP IF NO NOTE HEAD
22400 N1121: CAIL 14,=400 ;IF(J6)GO TO 1322
22500 JRST N123
22600 SKIPGE .COMM.+=27 ; J6
22700 JRST N1322
22800 CAIGE 14,=200 ;IF(L.LT.200)GO TO 125
22900 JRST N125
23000 N1322: CAIL 14,=200 ;1322 IF(L.GE.200)GO TO 1253
23100 JRST N1253
23200 ; FOR DIAMOND AND X NOTES.
23300 MOVEI 12,1 ;KL=1
23400 MOVE 11,[7.0] ;RG=7.
23500 ; FOR WHITE NOTES ON DPY.
23600 MOVE .COMM.+=28 ;JSA 16,MOD ;WHOLE=MOD(J7,10)
23700 IDIVI =10 ;JUMP .COMM.+=28
23800 MOVEM 1,ALF+=71 ;JUMP [=10] ; WHOLE
24000 JUMPE 1,N2122 ;IF(WHOLE.EQ.0)GO TO 2122
24100 SETZM .COMM.+=43 ;STEM=0
24200 ; FOR VARIOUS AUTOMATIC FEATURES IN 'SCORE' SECTION.
24300 SETZM .COMM.+=28 ;J7=0
24400 JSA 16,AMOD ;R5=AMOD(R5,10.)
24500 JUMP .COMM.+6
24600 JUMP [10.0]
24700 MOVEM .COMM.+6
24800 FIXX(0)
24900 MOVEM .COMM.+=26 ;J5=R5
25000 SKIPGE PLTR ;IF(PLT)GO TO 2121
25100 JRST N2121
25200 MOVE 2,ALF+=71 ;IF(WHOLE.NE.2)GO TO 1253
25300 CAIE 2,2
25400 JRST N1253 ;RQ=POS-18.*RSTJ2+RST7*(R4-1.)
25500 MOVN [18.0]
25600 FMPR STF+10
25700 MOVE 1,.COMM.+5 ; R4
25800 FSBR 1,[1.0]
25900 FMPR 1,ALF+=46 ; RST7
26000 FADR 1,0
26100 FADR 1,POSI+=9 ; POS
26200 MOVEM 1,ALF+=64 ; RQ
26300 FADR 1,ALF+=46 ;CALL LINX(R3,RQ,R3,RQ+RST7+RST7)
26400 FADR 1,ALF+=46
26500 MOVEM 1,ALF+=65 ; (RH)
26600 JSA 16,LINX
26700 JUMP .COMM.+4
26800 JUMP ALF+=64
26900 JUMP .COMM.+4 ;PUT IN LINE TO SHOW DBL WHOLE ON SCREEN (P7=2)
27000 JUMP ALF+=65
27100 N2122: SKIPL PLTR ;2122 IF(PLT.GE.0)GO TO 1253
27200 JRST N1253
27300 N2121: CAIL 14,=200 ;2121 IF(L.GE.200)GO TO 1253
27400 JRST N1253
27500 MOVE ALF+=71 ;J5=15+WHOLE
27600 ADDI =15
27700 MOVEM .COMM.+=26
27800 ; IF WHOLE=1, THEN WHOLE NOTE SHAPE INSTEAD OF HALF. (P7=1)
27900 MOVE STF+10 ;RG=RSTJ2
28000 MOVEM ALF+=59 ; RG FOR NOW
28100 ; FIX THIS SOME DAY↓↓ SEE 1342+1!
28200 ; THESE NOTES ARE IN CLEF1. 1/2=13, WHOLE=14
28300 MOVE .COMM.+=25 ;JX4=J4
28400 MOVEM ALF+=68 ; JX4
28500 MOVE .COMM.+10 ;RQ=R7
28600 MOVEM ALF+=64 ; RQ
28700 JSA 16,DRWNT ; CALL DRWNT
28800 ; SAVE IT FOR DOTS
29000 MOVE ALF+=59 ;R7=RQ
29100 MOVEM STF+10
29200 MOVE ALF+=68 ;J4=JX4
29300 MOVEM .COMM.+=25 ; GET 'EM BACK
29400 MOVE ALF+=64 ;RSTJ2=RG
29500 MOVEM .COMM.+10 ; (R7)
29600 ; DRAWS GOOD NOTES ON PLOTTER, NOT ON DPY
29700 JRST N123 ;GO TO 123
29800 N1251: JSA 16,NOIR ;1251 CALL NOIR(RMINI)
29900 JUMP ALF+=49 ; FOR QUARTER NOTES ON PLOTTER.
30000 JRST N123 ;GO TO 123
30100
30150 N125: MOVEM 10,ALF+=55 ; SAVE RB
30200 SKIPGE PLTR ;125 IF(PLT)GO TO 1251
30300 JRST N1251
30400 MOVE 11,[22.0] ;RG=22
30500 MOVEI 12,=17 ;KL=17
30600 N1253: MOVEM 12,ALF+=60
30700 ; ABOVE IS NEW NOTES ROUTINE
30710 SETZM STAFF
30755 MOVE .COMM.+4
30777 MOVEM ALF+=69 ;RH=R3
30800 MOVEM 11,ALF+=59
30900 JSA 16,RDRAW ;1253 CALL RDRAW(KL,RG,RNOTE,RMINI,RH,CENTR,RMINI)
31000 JUMP ALF+=60
31100 JUMP ALF+=59
31200 JUMP DAT+=89
31300 JUMP ALF+=49
31400 JUMP ALF+=69
31500 JUMP .COMM.+2
31600 JUMP ALF+=49
31650 SKIPL STAFF
31700 SKIPL PLTR ;IF(PLT.GE.0)GO TO 123
31800 JRST N123
31900 MOVE 12,ALF+=60 ;IF(KL.EQ.8)GO TO 2253
32000 CAIN 12,=8
32100 JRST N2253
32200 CAIE 12,=13 ;IF(KL.NE.13)GO TO 123
32300 JRST N123
32400 ; MAKE DBL THICK X AND DIAMOND NOTES
32500 N2253: MOVE .COMM.+4 ;2253 RH=R3-1.0
32600 FSBR [1.0]
32700 MOVEM ALF+=69
32800 ; GO BACK FOR THIS ;CALL RDRAW(KL,RG,RNOTE,RMINI,RH,CENTR,RMINI)
32900 SETOM STAFF
33000 JRST N1253+5
33600 N123: MOVN 2,.COMM.+=26 ;R5=R5-J5
33700 TLC 2,232000
33800 FADR 2,2
33900 FADRM 2,.COMM.+6
34010 SKIPN .COMM.+=43 ;IF(STEM.EQ.0)RETURN
34020 JRA 16,(16)
34100
34110 MOVE 10,ALF+=55 ; PUT RB BACK INTO 10
34120 MOVE 14,ALF+=63 ; GET BACK L
34400 CAIL 14,=300
34500 JRST N128
34600 MOVE 10,ALF+=66 ; RZTM
34700 FADR 10,.COMM.+2 ; RB R5=STEPS TO LEFT FOR ACCID. (.1=1 STEP)
34800 N128: MOVE 5,.COMM.+=28 ;JSA 16,MOD
34900 IDIVI 5,=10 ;JUMP .COMM.+=28
35000 MOVEM 6,.COMM.+=28 ;JUMP [=10] ;IF(STEM.EQ.0)GO TO 1242
35100 ;IF(L.LT.300)RB=CENTR+RZTM
35200 SOJ 6, ; ≥300 IS FOR 'X' NOTES.
35300 IMULI 6,=14 ;128 J7=MOD(J7,10)
35400 TLC 6,232000 ;RG=(J7-1)*14
35500 FADR 6,6
35600 SKIPGE 6 ;IF(RG)RG=0
35700 SETZ 6, ; 6 IS RG
35900 MOVE 2,.COMM.+=9 ;999 IS STANDARD (0) STEM LENGTH.
36000 CAME 2,[999.0] ;IF(R8.NE.999)GO TO 1751
36100 JRST N1751
36200 SETZ 2, ;R8=0
36300 SETZ 15, ; 15 = RH=0
36400 JRST N2751 ;GO TO 2751
36500 N1751: CAMG 2,[999.0] ;1751 IF(R8.LT.999)GO TO 751
36600 JRST N751
36700 FSBR 2,[1000.0] ;R8=R8-1000.
36800 MOVEI 3,1 ; 3 IS J10=1
36900 N751: MOVE 15,2 ; 1000+ PUTS SLASH ON NOTE STEM
37000 FMPR 15,ALF+=46 ;15 IS RH 751 RH=R8*RST7
37100 N2751: MOVEM 2,.COMM.+=9 ; R8
37110 MOVE .COMM.+=26 ;JSA 16,MOD
37120 IDIVI =10 ;JUMP .COMM.+=26 ;J5=MOD(J5,10) ACCI NOW IN J5
37130 MOVEM 1,.COMM.+=26 ;JUMP [=10]
37200 MOVE .COMM.+=43 ; STEM EXTENSIONS ARE BY NOTE #S
37300 CAIE 2 ;2751 IF(STEM.NE.2)GO TO 1280
37400 JRST N1280
37500 MOVE 5,.COMM.+4 ;RJX=R3
37600 FADR 6,[48.0] ; FOR STEM DOWN (=2)
37700 MOVNS 6 ;RG=-RG-48.
37800 MOVNS 15 ;RH=-RH
37900 ;*** SEE AT N2751 MOVEI 14,=20 ;L=20
38000 MOVN 4,ALF+=66 ; RZTM RB=RB-RZTM*2
38100 FMPR 4,[2.0] ; FOR TILT OF ORDINARY NOTES (NOT X OR DIAMOND)
38200 FADR 10,4 ; RB IS 10 (SEE 'WAY BACK)
38300 JRST N129 ;GO TO 129
38400 N1280: MOVE 5,[14.54] ; NEXT IS FOR STEM UP.
38500 SKIPN .COMM.+=27 ;1280 RJX=RSTM
38600 JRST N2322 ;IF(J6.EQ.0)GO TO 2322
38700 MOVE .COMM.+=27 ;IF(J6.NE.30)RJX=16.2
38800 CAIE =30
38900 MOVE 5,[16.2] ; FOR HALF NOTES
39000 N2322: FMPR 5,ALF+=49 ;2322 RJX=RJX*RMINI+R3
39100 FADR 5,.COMM.+4
39200 FADR 6,[48.0] ; 6 IS RG=RG+48.
39300 ;*** SEE AT N2751 MOVEI 14,=10 ;L=10
39400 N129: FMPR 6,ALF+=49 ;129 RZ=CENTR+RH+RG*RMINI
39500 FADR 6,15
39600 FADR 6,.COMM.+2
39700 MOVEM 6,ALF+=57
39800 MOVE 4,ALF+=49 ;IF(RMINI.NE.RSTJ2)RJW=RJW*.6
39900 CAMN 4,STF+=8
40000 JRST .+4
40100 MOVE ALF+=56
40200 FMPR [0.6]
40300 MOVEM ALF+=56
40400 MOVEM 5,ALF+=53 ; RJX
40500 MOVEM 10,ALF+=55 ; RB
40600 JSA 16,LINX ;CALL LINX(RJX,RB,RJX,RZ)
40700 JUMP ALF+=53
40800 JUMP ALF+=55
40900 JUMP ALF+=53
41000 JUMP ALF+=57
41100 ;****N227: MOVN 14 ; RB HERE IS CENTR (FOR 'X' NOTES OR NOT)
41200 ;** SEE AT N2751*** ADDM .COMM.+=26 ;227 J5=J5-L
41300 N227: SKIPG .COMM.+=28 ; J5 HAS ACCID. # NOW
41400 JRA 16,(16) ;IF(J7.LE.0)GO TO 1242
41500 MOVE [2.0] ; JUMP IF NO TAILS
41600 FMPR ALF+=49 ;RJW=2.*RMINI/RSTJ2
41700 FDVR STF+10
41800 MOVEM ALF+=56
41900 MOVE 3,[1.0] ;RA=1.
42000 MOVE .COMM.+=43 ; FOR VERT. SPACING OF MULTIPLE TAILS
42100 CAIE 2 ;IF(STEM.NE.2)GO TO 1127
42200 JRST N1127
42300 MOVN .COMM.+=9 ;R4=R4-3.7-R8
42400 FSBR [3.7] ; R4 IS USED IN SUBR. TAIL - R8 IS STEM EXTENSION.
42500 FADRM .COMM.+5
42600 MOVNS ALF+=56 ;RJW=-RJW
42700 JRST N127 ;GO TO 127
42800 N1127: MOVE .COMM.+=9 ;1127 R4=R4-2+R8
42900 FSBR [2.0]
43000 FADRM .COMM.+5
43100 ; 2 ABOVE AND 3.7 BEFORE ARE BECAUSE ORIG. POS. OF TAIL DRWING IS OFF.
43200 MOVNS 3 ;RA=-RA
43300 SETZM .COMM.+=9 ;R8=0 FOR SHIFT AT 246
43400 N127: MOVEM 3,ALF+=51 ; RA
43500 JSA 16,TAIL ;127 CALL TAIL
43600 SOS .COMM.+=28 ;1028 J7=J7-1
43700 SKIPN .COMM.+=28 ;IF(J7.EQ.0)GO TO 327
43800 JRST N327
43900 MOVE ALF+=56 ;R4=R4+RJW
44000 FADRM .COMM.+=5
44100 JRST N127+1 ; GO TO 127 MOVES CENTR UP OR DOWN FOR NEXT TAIL
44200 N327: MOVE .COMM.+=5 ;327 IF(R4.GE.RX4)RX4=R4+1
44300 CAMGE .COMM.+=42
44400 JRST .+3
44500 FADR [1.0]
44600 MOVEM .COMM.+=42 ; FOR TRILLS, ETC.
44700 SKIPN .COMM.+=11 ;IF(J10.EQ.0)GO TO 1242
44800 JRA 16,(16)
44900 MOVN [19.0] ;RJY=RZ-19*RSTJ2
45000 FMPR STF+10
45100 FADR ALF+=57 ; 0 IS RJY FOR NOW
45200 MOVN 2,[4.0] ;RZ=RZ-RSTJ2*4.
45300 FMPR 2,STF+10
45400 FADRM 2,ALF+=57
45500 SKIPGE ALF+=51 ;IF(RA.LT.0)GO TO 1327
45600 JRST N1327 ; NEXT IS FOR STEM DOWN SLASH
45700 MOVE [23.0] ;RJY=RZ+23*RSTJ2
45800 FMPR STF+10
45900 FADR ALF+=57 ; 0 IS RJY
46000 MOVE 2,ALF+=46 ;RZ=RZ+RST7
46100 FADRM 2,ALF+=57
46200 N1327: MOVN 2,ALF+=46 ;1327 RJX=RJX-RST7
46300 FADRM 2,ALF+=53
46400 MOVEM ALF+=54 ; RJY
46500 MOVE [17.0]
46600 FMPR STF+10
46700 FADR ALF+=53
46800 MOVEM ALF+=71
46900 JSA 16,LINX ;CALL LINX(RJX,RJY,RJX+17.*RSTJ2,RZ)
47000 JUMP ALF+=53
47100 JUMP ALF+=54
47200 JUMP ALF+=71
47300 JUMP ALF+=57 ;FOR SLASH ON GRACE NOTE TAIL
47400 JRA 16,(16)
47500
47600
50000 ; REAL DIS,DISX,HGT,POS,CENTR,STFF,HGT1
50100 ; COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/BM/RA,RC,RJY
50200 ; COMMON/POSI/STFF(-3/4),JJ2,POS/PLTR/PLT,RHT,DIS
50300 ; EQUIVALENCE (J3,JQ(1)),(J4,JQ(2)),(J5,JQ(3)),(R5,RJQ(3))
50400 ; 1,(R6,RJQ(4)),(J7,JQ(5)),(J8,JQ(6)),(J9,JQ(7)),(J10,JQ(8))
50500 ; 1,(J11,JQ(9)),(J6,JQ(4)),(R9,RJQ(7)),(R8,RJQ(6)),(R3,RJQ(1))
50600 ; 1 ,(R7,RJQ(5)),(R4,RJQ(2)),(R9,RJQ(7)),(R10,RJQ(8)),(RX3,RJQ(20))
50700 STAFF: 0 ;100 RA=0
50800 ; FOR STAFF LINES: 8, POS 1, HGT(3 TO -3), UP-DOWN(NT #S),
50900 ; P5=SIZE, P6=2ND POS., P7=(1=INVIS.), P8=SPACER, P9=INST. NAME
51000 ; P6=SIZE FACTOR, IF P7≠0 STAFF IS INVIS.
51100 ; PLT =-2 MAKES HEAVY STAFF.(FOR XGP)
51200 ; IF(R5.EQ.0)R5=RSTFAC(J2)
51300 MOVE 2,.COMM.+6
51400 JUMPN 2,.+5
51500 MOVE 3,.COMM.+3 ; J2
51600 MOVE 2,STF+3(3) ; TEMP. R5 IS 2
51700 SKIPN 2 ;CALL NOZERO(R5)
51800 MOVE 2,[1.0]
51900 MOVEM 2,STF+3(3) ;RSTFAC(J2)=R5
52000 MOVE 4,.COMM.+5 ;RX=(J2+3)*123-369.+AMOD(R4,100.)*7.*R5
52100 FMPR 4,[7.0]
52200 FMPR 4,2
52300 MOVE 7,3
52400 ADDI 7,3 ; J2+3
52500 IMULI 7,=123
52600 SUBI 7,=369
52700 TLC 7,232000
52800 FADR 7,7
52900 FADR 7,4 ; 7 IS RX
53000 MOVEM 7,POSI+3(3) ;STFF(J2)=RX
53100 MOVE 13,[3.0] ; RTF RX=RX+RTF*R5
53200 FMPR 13,2
53300 FADR 13,7 ; 13 IS RX
53400 ; FOR RTF SEE DATA
53500 ; 13 IS RA THIS COMES DOWN AT STF69 RA=RX
53600 ; FOR 2 PASS PLOTTING
53700 JSA 16,RHORZ ;RJ=RHORZ(R6)
53800 JUMP .COMM.+7
53900 SKIPN .COMM.+7
54000 MOVE [596.0] ;IF(R6.EQ.0)RJ=596
54100 MOVEM ALF+4 ; RJ
54200 FMPR 2,[14.0] ;R5=R5*14.
54300 MOVEM 2,.COMM.+6
54400 SKIPE .COMM.+11 ;IF(R8.EQ.0)GO TO 68
54500 SKIPGE PLTR
54600 JRST STF68 ;IF(PLT)GO TO 68
54700 MOVE 14,.COMM.+11 ;RZ=RX+R8*167.
54800 FMPR 14,[167.0]
54900 FADR 14,13 ; 13 IS RX
55000 ;;; MOVEM 14,ALF+5 ; RZ
55100 ; 167 IS A MAGIC NUMBER!! PUTS LINE ON DPY.
55200 JSA 16,LINX ;CALL LINX(R3,RZ,RJ,RZ)
55300 JUMP .COMM.+4
55400 JUMP 14
55500 JUMP ALF+4
55600 JUMP 14
55700 ; SHOWS WHERE NEXT STAFF 0 WILL BE.
55800 STF68: SKIPN .COMM.+=28 ;68 IF(J7.EQ.0)GO TO 101
55900 JRST STF101
56000 SKIPE PLTR ;IF(PLT.EQ.0)CALL LINES(-596.,RX,3)
56100 JRA 16,(16)
56200 JSA 16,LINES
56300 [-596.0]
56400 13
56500 [3]
56600 ; TO ACTIVATE DPY BUFFER
56700 JRA 16,(16) ;RETURN
56800 STF101: MOVE 14,.COMM.+=25 ;101 L=IABS(J4/100)
56900 IDIVI 14,=100 ; AC 15 NOT USED
57000 MOVM 14
57100 SKIPN 14, ;IF(L.EQ.0)L=5
57200 MOVEI 14,5 ; L IS 14
57300 ; P4=0=STANDARD 5-LINE STAFF. 600=6 LINES, ETC.
57500 MOVE 11,ALF+4
57600 ;;; MOVE 10,.COMM.+4
57605 MOVEM 13,NTS
57610 STF69: SETZ 12, ; K 69 DO 6 K=1,L
57700 STF1: JSA 16,LINX
57800 JUMP 11 ;RZ=RJ
57900 JUMP 13 ;RW=R3
58000 JUMP .COMM.+4 ;IF(K.EQ.2)GO TO 66
58100 JUMP 13 ;IF(K.NE.4)GO TO 67
58200 EXCH 11,.COMM.+4 ;66 CALL EXCH(RW,RZ)
58300 FADR 13,.COMM.+6 ;67 CALL LINX(RZ,RX,RW,RX)
58400 AOJ 12, ;6 RX=RX+R5
58500 CAMGE 12,14
58600 JRST STF1
58700 MOVNI 2 ;IF(RA.EQ.1000)RETURN
58800 CAMN PLTR ;IF(PLT.NE.-2)RETURN
58900 SKIPN NTS ;RX=RA-1./RHT
59000 JRA 16,(16)
59100 MOVN 13,[1.0] ;RA=1000
59200 FDVR 13,PLTR+1
59300 FADR 13,NTS
59400 SETZM NTS ;GO TO 69
59500 JRST STF69 ;END
59600 END